home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / nt / emacssrc.zip / EMACSSRC.TAR / emacs-19.17 / lisp / two-column.el < prev    next >
Text File  |  1993-07-23  |  25KB  |  632 lines

  1. ;;; two-column.el --- minor mode for editing of two-column text
  2.  
  3. ;; Copyright (C) 1992 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Daniel Pfeiffer <pfeiffer@cix.cict.fr>
  6. ;; Adapted-By: ESR
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 1, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; This package gives you the ability to edit text in a two-column format.
  27.  
  28. ;; --8<---- two-column.el ----8<--------8<--------8<--------8<--------8<-------
  29. ;; Esperanto:                English:
  30.  
  31. ;; Minora modalo por samtempa dukolumna    Minor mode for simultaneous
  32. ;; tajpado                two-column editing
  33.  
  34. ;; ^Ci dataro estas ero de GNU Emacs.    This file is part of GNU Emacs.
  35.  
  36. ;; GNU  Emacs  estas  disdonata   en la    GNU Emacs is distributed in the hope
  37. ;; espero  ke ^gi estos utila,  sed SEN    that it will  be useful, but WITHOUT
  38. ;; IA  GARANTIO.   Neniu   a^utoro  a^u    ANY    WARRANTY.     No  author   or
  39. ;; disdonanto  akceptas respondecon  al    distributor   accepts responsibility
  40. ;; iu ajn  por la sekvoj de ^gia uzado,    to  anyone for the   consequences of
  41. ;; a^u  ^cu  ^gi serveblas al  iu celo,    using it or  for  whether it  serves
  42. ;; a^u e^c  entute funkcias,  se  li ni    any particular purpose   or works at
  43. ;; estas skribinta  tion.  Vidu la  GNU    all,  unless he says so  in writing.
  44. ;; Emacs ^Generala Publika  Licenco por    Refer  to  the   GNU  Emacs  General
  45. ;; plenaj detaloj.            Public License for full details.
  46.  
  47. ;; ^Ciu rajtas  kopii,  modifi kaj  ree    Everyone  is  granted permission  to
  48. ;; disdoni  GNU Emacs,  sed nur  sub la    copy,  modify and  redistribute  GNU
  49. ;; condi^coj  priskribitaj  en  la  GNU    Emacs, but only under the conditions
  50. ;; Emacs  ^Generala  Publika   Licenco.    described in  the  GNU Emacs General
  51. ;; Kopio de  tiu licenso estas supozata    Public  License.   A copy   of  this
  52. ;; donita al vi kune kun GNU Emacs, por    license  is supposed to have    been
  53. ;; ke   vi  sciu   viajn  rajtojn   kaj    given to you along with GNU Emacs so
  54. ;; respondecojn.   ^Gi  devus  esti  en    you   can   know   your   rights and
  55. ;; dataro    nomata    COPYING.   Inter    responsibilities.  It should be in a
  56. ;; alia^joj,  la notico  pri  kopirajto    file named    COPYING.   Among other
  57. ;; kaj  ^ci  notico devas esti  gardata    things, the  copyright   notice  and
  58. ;; sur ^ciuj kopioj.            this notice must be preserved on all
  59. ;;                    copies.
  60.  
  61.  
  62. ;; Tiu minora  modalo  ebligas  al   vi    This     minor mode  allows  you  to
  63. ;; tajpi   sendepende  en   du   apudaj    independently    edit two   adjacent
  64. ;; bufroj.  Vi  havas tri eblecojn  por    buffers.    You have three  ways  to
  65. ;; eki    ^gin.   ^Ciu  donas  al    vi    start it  up.   Each  gives   you  a
  66. ;; horizontale   disigatan   fenestron,    horizontally split window similar to
  67. ;; simila  al  fina   apareco  de   via    the final outcome of your text:
  68. ;; teksto:
  69.  
  70. ;; C-x 6 2  asocias  novan  bufron  nomatan  associates a new  buffer called
  71. ;;       same, sed kun 2C/ anta^u.        the   same,    but   with   2C/
  72. ;;                        prepended.
  73.  
  74. ;; C-x 6 b  asocias alian bufron.  Vi povas  associates    another   buffer.
  75. ;;       anka^u asocii  dataron,   se vi  This can be used to associate a
  76. ;;       ^jus anta^ue faris C-x C-f.        file if you just did C-x C-f.
  77.  
  78. ;; C-x 6 u  disigas  jam dukolumnan tekston  unmerges a two-column text into
  79. ;;       en  du   bufroj  ekde  la  nuna  two  buffers from  the  current
  80. ;;       linio,  kaj je la nuna kolumno.  line and at the current column.
  81. ;;       La    anta^uaj   signoj   (ofte  The preceding characters (often
  82. ;;       tabeligilo  a^u  |)  estas   la  tab   or  |)  are   the  column
  83. ;;       kolumna disiganto.  Linioj kiuj  separator.   Lines  that  don't
  84. ;;       ne   enhavas   ilin   ne  estas  have them  won't  be separated.
  85. ;;       disigitaj.   Kiel  la kvara kaj  Like the  fourth and fifth line
  86. ;;       la   kvina  linio se vi disigas  if  you unmerge this  file from
  87. ;;       ^ci dataron ekde la unua  angla  the first english word.
  88. ;;       vorto.
  89.  
  90. ;; Je ^cia  flanko  estas  bufro,   kiu    On each side is a buffer  that knows
  91. ;; konas la  alian.  Kun la ordonoj C-x    about the other.  With the  commands
  92. ;; 6 SPC, C-x 6 DEL  kaj  C-x 6 RET oni    C-x 6 SPC,  C-x 6 DEL  and C-x 6 RET
  93. ;; povas   suben-   a^u  supreniri  unu    you can  simultaneously scroll up or
  94. ;; ekranon,    kaj   subeniri   linion,    down by  a screenfull  and by a line
  95. ;; samtempe en la du bufroj. Al la alia    in both buffers.   Empty lines   are
  96. ;; bufro  estas   aldonataj  linioj  se    added to  the  other    buffer    if
  97. ;; necesas,  por  ke  vi vidu la  saman    necessary, so that  you see the same
  98. ;; parton.  Per  C-x  6  C-l vi   povas    part.   With   C-x 6  C-l    you can
  99. ;; recentrigi la linion.    Kiam vi nur    recenter the line.   When  you  only
  100. ;; plu  havas    unu el   la du  bufroj    have one of the two buffers onscreen
  101. ;; surekrane vi  revidos la alian   per    you can get the other back  with C-x
  102. ;; denove C-x 6 2.            6 2 once more.
  103.  
  104. ;; Se  vi  volas  meti  longajn liniojn    If you include long lines, i.e which
  105. ;; (ekz. programerojn) en la  kunigotan    will span both columns  (eg.  source
  106. ;; tekston,   ili  devas  esti  en   la    code), they should  be  in what will
  107. ;; estonte unua kolumno.  La alia devas    be the    first column,    with  the
  108. ;; havi malplenajn linion apud ili.    associated buffer having empty lines
  109. ;;                    next to them.
  110.  
  111. ;; Averto: en Emacs kiam vi ^san^gas la    Attention:  in Emacs when you change
  112. ;; ma^joran modalon, la minoraj modaloj    the major mode,  the minor modes are
  113. ;; estas  anka^u  elmemorigitaj.   Tiu-    also  purged  from  memory.  In that
  114. ;; okaze  vi devas religi la du bufrojn    case you   must  reassociate the two
  115. ;; per iu  C-x 6-ordono,  ekz. C-x 6 b.    buffers with any C-x 6-command, e.g.
  116. ;;                    C-x 6 b.
  117.  
  118. ;; Kiam   vi   estos  kontenta   de  la    When you have edited both buffers to
  119. ;; rezulto, vi kunmetos la du kolumnojn    your  content,  you merge them  with
  120. ;; per  C-x 6 1.   Se  vi  poste  vidas    C-x 6 1.  If you then see a problem,
  121. ;; problemon, vi  neniigu   la kunmeton    you undo the  merge with  C-x u  and
  122. ;; per C-x u  kaj  plue  modifu  la  du    continue   to  edit the two buffers.
  123. ;; bufrojn.  Kiam vi ne plu volas tajpi    When you  no longer  want to edit in
  124. ;; dukolumne,  vi  eliru el  la  minora    two  columns, you turn off the minor
  125. ;; modalo per C-x 6 k.            mode with C-x 6 k.
  126.  
  127.  
  128. ;; An^stata^u tri `autoload' kaj tri  |  Instead  of  three  `autoload' and
  129. ;; `global-set-key'  vi povas uzi la  |  three `global-set-key' you can use
  130. ;; jenon en via dataro ~/.emacs, por  |  the    following   in  your   file
  131. ;; memstare ^car^gi la modalon:          |  ~/.emacs,  to  automatically  load
  132. ;;                      |  the mode:
  133.  
  134. ;;    (global-set-key "\C-x6"
  135. ;;            '(lambda () (interactive)
  136. ;;               (load-library "two-column")
  137. ;;               (call-interactively
  138. ;;                (cdr (assq (read-char) tc-mode-map)))))
  139.  
  140. ;; Se vi ^satus  havi la dukolumnajn  |  If     you'd like   to  have   the
  141. ;; ordonojn je funkciklavo <f2>,  vi  |  two-column  commands   on function
  142. ;; povas  uzi la jenon en via dataro  |  key   <f2>,  you  can     use  the
  143. ;; ~/.emacs:                  |  following in your file ~/.emacs:
  144.  
  145. ;; (global-set-key [f2] (function
  146. ;;                       (lambda ()
  147. ;;                         (interactive)
  148. ;;                         (load-library "two-column")
  149. ;;                         (global-set-key [f2] tc-mode-map)
  150. ;;                         (call-interactively
  151. ;;                          (cdr (assq (read-char) tc-mode-map))))))
  152.  
  153. ;; In addition to two-column editing of text, for example for writing a
  154. ;; bilingual text side-by-side as shown below in the file's prolog, other
  155. ;; interesting uses have been found for this minor mode:
  156. ;; 
  157. ;; 
  158. ;; You can separate the columns with   {+} C-x 6 u  or  <f2> u  if you prefer
  159. ;; any string that pleases you, by     {+} handles these with a prefix argument
  160. ;; setting tc-separator.  For          {+} that enables you to declare the
  161. ;; example "{+}  " if you like to      {+}  desired length of such a string.
  162. ;; amuse yourself.
  163. ;; 
  164. ;; 
  165. ;; keyword You can write any text corresponding to a
  166. ;;       given keyword in a filled paragraph next to
  167. ;;       it.  Note that the width of the first column
  168. ;;       may be less than window-min-width in the
  169. ;;       result, but will be displayed at that width.
  170. ;; 
  171. ;; another This is not a three- or multi-column mode.
  172. ;;       The example in the file's prolog required
  173. ;;       working on two columns and then treating the
  174. ;;       result as one column in order to add the
  175. ;;       third.
  176. ;; 
  177. ;; 
  178. ;; Programmers might like the ability to split off the comment column of
  179. ;; a file that looks like the following.  The advantage is that with
  180. ;; (setq fill-prefix "-- ") you can run M-q (fill-paragraph) on the
  181. ;; comment.  The problem is, code quickly gets rather wide, so you need
  182. ;; to use a narrower comment column, which is less interesting, unless
  183. ;; you have a 132-column screen.  Code lines that reach beyond
  184. ;; comment-column are no problem, except that you won't always see their
  185. ;; end during editing.
  186. ;; 
  187. ;; BEGIN                -- This is just some meaningless
  188. ;;     FOR i IN 1..10 LOOP        -- code in Ada, that runs foobar
  189. ;;     foobar( i );            -- once for each argument from one
  190. ;;     END LOOP;            -- to ten, and then we're already
  191. ;; END;                    -- through with it.
  192. ;; 
  193. ;; Better yet, you can put the point before "This", type M-3 C-x 6 u
  194. ;; which makes "-- " the separator between a no-comments Ada buffer, and
  195. ;; a plain text comment buffer.  When you put them back together, every
  196. ;; non-empty line of the 2nd column will again be preceded by "-- ".
  197. ;; 
  198. ;; 
  199. ;; The <f2> function key hack (which is one of the rare times when
  200. ;; function keys are mnemonic) at the end of the file's prolog requires
  201. ;; that the lisp/term/*.el for your terminal use the standard
  202. ;; conventions.  Too bad that some don't (at least not in version 18.55).
  203. ;; The Sun one is hopelessly non-standard, and vt2[024]0 somehow forgot
  204. ;; to define <f1> thru <f5>.  (It defines <pf1> thru <pf4> instead, but
  205. ;; that is not what we need on an X terminal.)  If you want to use those,
  206. ;; you'll need another hack something like:
  207. ;; 
  208. ;;       (if (string= (system-name) "cix")
  209. ;;       (progn
  210. ;;         (load-library "term/vt200.el")
  211. ;;         (define-key CSI-map "12~" (cons function-keymap ?\^b)))
  212. ;;     (global-unset-key "\e[")
  213. ;;     (define-key esc-map "[225z" (cons function-keymap ?\^b)))
  214. ;; 
  215. ;; where "cix" is the non-sun machine I use.  Actually I use the same X
  216. ;; terminal to connect to both machines, and I want to keep my ~/.emacs
  217. ;; identical on both.  Bother, the two Emacses don't recognize the same
  218. ;; keys and assign different sequences to those they do!  I sure hope all
  219. ;; this nonsense will stop with version 19 (or preferably soon) where I'd
  220. ;; like to be able to say (define-key some-map '<f2> some-cmd), and see
  221. ;; <f2> rather than some unintelligible ESC-sequence in command key
  222. ;; sequences.
  223.  
  224. ;;; Code:
  225.  
  226. ;;;;; Set up keymap ;;;;;
  227.  
  228. ;;;###autoload
  229. (defvar tc-mode-map nil
  230.   "Keymap for commands for two-column mode.")
  231.  
  232. ;;;###autoload
  233. (if tc-mode-map
  234.     ()
  235.   (setq tc-mode-map (make-sparse-keymap))
  236.   (define-key tc-mode-map "1" 'tc-merge)
  237.   (define-key tc-mode-map "2" 'tc-two-columns)
  238.   (define-key tc-mode-map "b" 'tc-associate-buffer)
  239.   (define-key tc-mode-map "e" 'tc-dissociate)
  240.   (define-key tc-mode-map "\C-l" 'tc-recenter)
  241.   (define-key tc-mode-map "o" 'tc-associated-buffer)
  242.   (define-key tc-mode-map "s" 'tc-split)
  243.   (define-key tc-mode-map "{" 'shrink-window-horizontally)
  244.   (define-key tc-mode-map "}" 'enlarge-window-horizontally)
  245.   (define-key tc-mode-map " " 'tc-scroll-up)
  246.   (define-key tc-mode-map "\^?" 'tc-scroll-down)
  247.   (define-key tc-mode-map "\C-m" 'tc-scroll-line))
  248.  
  249. ;;;###autoload
  250. (global-set-key "\C-x6" tc-mode-map)
  251.  
  252. ;;;;; variable declarations ;;;;;
  253.  
  254. ;; markers seem to be the only buffer-id not affected by renaming
  255. ;; a buffer.  This nevertheless loses when a buffer is killed.
  256. (defvar tc-other nil
  257.   "Marker to the associated buffer, if non-nil.")
  258. (make-variable-buffer-local 'tc-other)
  259. (put 'tc-other 'permanent-local t)
  260.  
  261. (setq minor-mode-alist (cons '(tc-other " 2C") minor-mode-alist))
  262.  
  263. ;; rearranged, so that the pertinent info will show in 40 columns
  264. (defvar tc-mode-line-format
  265.     '("-%*- %15b --"  (-3 . "%p")  "--%[("  mode-name
  266.       minor-mode-alist  "%n"  mode-line-process  ")%]%-")
  267.   "*Value of mode-line-format for a buffer in two-column minor mode.")
  268.  
  269. (defvar tc-separator ""
  270.   "*A string inserted between the two columns when merging.
  271. This gets set locally by \\[tc-split].")
  272. (put 'tc-separator 'permanent-local t)
  273.  
  274. (defvar tc-window-width 40
  275.   "*The width of the first column.  (Must be at least `window-min-width')
  276. This value is local for every buffer that sets it.")
  277. (make-variable-buffer-local 'tc-window-width)
  278. (put 'tc-window-width 'permanent-local t)
  279.  
  280. (defvar tc-beyond-fill-column 4
  281.   "*Base for calculating `fill-column' for a buffer in two-column minor mode.
  282. The value of `fill-column' becomes `tc-window-width' for this buffer
  283. minus this value.")
  284.  
  285. (defvar tc-mode-hook nil
  286.   "Function called, if non-nil, whenever turning on two-column minor mode.
  287. It can get called by \\[tc-two-columns] (tc-two-columns), \\[tc-split] (tc-split)
  288. and \\[tc-associate-buffer] (tc-associate-buffer), on both buffers.")
  289.  
  290. ;;;;; base functions ;;;;;
  291.  
  292. ;; the access method for the other buffer.  this tries to remedy against
  293. ;; lost local variables and lost buffers.
  294. (defun tc-other ()
  295.   (if tc-other
  296.       (or (prog1
  297.           (marker-buffer tc-other)
  298.         (setq mode-line-format tc-mode-line-format ))
  299.       ; The associated buffer somehow got killed.
  300.       (progn
  301.         ; The other variables may later be useful if the user
  302.         ; reestablishes the association.
  303.         (kill-local-variable 'tc-other)
  304.         (kill-local-variable 'mode-line-format)
  305.         nil))))
  306.  
  307. ;;;###autoload
  308. (defun tc-two-columns (&optional buffer)
  309.   "Split current window vertically for two-column editing.
  310.  
  311. When called the first time, associates a buffer with the current
  312. buffer.  Both buffers are put in two-column minor mode and
  313. tc-mode-hook gets called on both.  These buffers remember
  314. about one another, even when renamed.
  315.  
  316. When called again, restores the screen layout with the current buffer
  317. first and the associated buffer to it's right.
  318.  
  319. If you include long lines, i.e which will span both columns (eg.
  320. source code), they should be in what will be the first column, with
  321. the associated buffer having empty lines next to them.
  322.  
  323. You have the following commands at your disposal:
  324.  
  325. \\[tc-two-columns]   Rearrange screen
  326. \\[tc-associate-buffer]   Reassociate buffer after changing major mode
  327. \\[tc-scroll-up]   Scroll both buffers up by a screenfull
  328. \\[tc-scroll-down]   Scroll both buffers down by a screenful
  329. \\[tc-scroll-line]   Scroll both buffers up by one or more lines
  330. \\[tc-recenter]   Recenter and realign other buffer
  331. \\[shrink-window-horizontally], \\[enlarge-window-horizontally]   Shrink, enlarge current column
  332. \\[tc-associated-buffer]   Switch to associated buffer
  333. \\[tc-merge]   Merge both buffers
  334.  
  335. These keybindings can be customized in your ~/.emacs by `tc-prefix'
  336. and `tc-mode-map'.
  337.  
  338. The appearance of the screen can be customized by the variables
  339. `tc-window-width', `tc-beyond-fill-column',
  340. `tc-mode-line-format' and `truncate-partial-width-windows'."
  341.  
  342.   (interactive "P")
  343.   ; first go to full width, so that we can certainly split into
  344.   ; two windows
  345.   (if (< (window-width) (frame-width))
  346.       (enlarge-window 99999 t))
  347.   (split-window-horizontally
  348.    (max window-min-width (min tc-window-width
  349.                   (- (frame-width) window-min-width))))
  350.   (if (tc-other)
  351.       (progn
  352.     (other-window 1)
  353.     (switch-to-buffer (tc-other))
  354.     (other-window -1)
  355.     ; align buffers if necessary
  356.     (tc-scroll-line 0))
  357.  
  358.     ; set up minor mode linking two buffers
  359.     (setq fill-column (- tc-window-width
  360.              tc-beyond-fill-column)
  361.       mode-line-format tc-mode-line-format)
  362.     (run-hooks tc-mode-hook)
  363.     (let ((other (point-marker)))
  364.       (other-window 1)
  365.       (switch-to-buffer
  366.        (or buffer
  367.        (generate-new-buffer
  368.         (concat "2C/" (buffer-name)))))
  369.       (or buffer
  370.       (text-mode))
  371.       (setq fill-column (- tc-window-width
  372.                tc-beyond-fill-column)
  373.         mode-line-format tc-mode-line-format
  374.         tc-other other
  375.         other (point-marker))
  376.       (run-hooks tc-mode-hook)
  377.       (other-window -1)
  378.       (setq tc-other other))))
  379.  
  380. (defalias 'tc-mode 'tc-two-columns)
  381.  
  382. ;;;###autoload
  383. (defun tc-associate-buffer ()
  384.   "Associate another buffer with this one in two-column minor mode.
  385. Can also be used to associate a just previously visited file, by
  386. accepting the proposed default buffer.
  387.  
  388. See  \\[tc-two-columns]  and  `lisp/two-column.el'  for further details."
  389.   (interactive)
  390.   (let ((b1 (current-buffer))
  391.     (b2 (or (tc-other)
  392.         (read-buffer "Associate buffer: " (other-buffer)))))
  393.     (save-excursion
  394.       (setq tc-other nil)
  395.       (set-buffer b2)
  396.       (and (tc-other)
  397.        (not (eq b1 (tc-other)))
  398.        (error "Buffer already associated with buffer `%s'."
  399.           (buffer-name (tc-other))))
  400.       (setq b1 (and (assq 'tc-window-width (buffer-local-variables))
  401.             tc-window-width)))
  402.     ; if other buffer has a local width, adjust here too
  403.     (if b1 (setq tc-window-width (- (frame-width) b1)))
  404.     (tc-two-columns b2)))
  405.  
  406. ;;;###autoload
  407. (defun tc-split (arg)
  408.   "Unmerge a two-column text into two buffers in two-column minor mode.
  409. The text is unmerged at the cursor's column which becomes the local
  410. value of `tc-window-width'.  Only lines that have the ARG same
  411. preceding characters at that column get split.  The ARG preceding
  412. characters without any leading whitespace become the local value for
  413. `tc-separator'.  This way lines that continue across both
  414. columns remain untouched in the first buffer.
  415.  
  416. This function can be used with a prototype line, to set up things as
  417. you like them.  You write the first line of each column with the
  418. separator you like and then unmerge that line.  E.g.:
  419.  
  420. First column's text    sSs  Second columns text
  421.                \\___/\\
  422.             /    \\
  423.    5 character Separator      You type  M-5 \\[tc-split]  with the point here
  424.  
  425. See  \\[tc-two-columns]  and  `lisp/two-column.el'  for further details."
  426.   (interactive "p")
  427.   (and (tc-other)
  428.        (if (y-or-n-p (concat "Overwrite associated buffer `"
  429.                  (buffer-name (tc-other))
  430.                  "'? "))
  431.        (save-excursion
  432.          (set-buffer (tc-other))
  433.          (erase-buffer))
  434.      (signal 'quit nil)))
  435.   (let ((point (point))
  436.     ; make next-line always come back to same column
  437.     (goal-column (current-column))
  438.     ; a counter for empty lines in other buffer
  439.     (n (1- (count-lines (point-min) (point))))
  440.     chars other)
  441.     (save-excursion
  442.       (backward-char arg)
  443.       (setq chars (buffer-substring (point) point))
  444.       (skip-chars-forward " \t" point)
  445.       (make-local-variable 'tc-separator)
  446.       (setq tc-separator (buffer-substring (point) point)
  447.         tc-window-width (current-column)))
  448.     (tc-two-columns)
  449.     (setq other (tc-other))
  450.     ; now we're ready to actually unmerge
  451.     (save-excursion
  452.       (while (not (eobp))
  453.     (if (not (and (= (current-column) goal-column)
  454.               (string= chars
  455.                    (buffer-substring (point)
  456.                          (save-excursion
  457.                            (backward-char arg)
  458.                            (point))))))
  459.         (setq n (1+ n))
  460.       (setq point (point))
  461.       (backward-char arg)
  462.       (skip-chars-backward " \t")
  463.       (delete-region point (point))
  464.       (setq point (point))
  465.       (insert-char ?\n n)
  466.       (append-to-buffer other point (progn (end-of-line)
  467.                            (if (eobp)
  468.                            (point)
  469.                          (1+ (point)))))
  470.       (delete-region point (point))
  471.       (setq n 0))
  472.     (next-line 1)))))
  473.  
  474. ;;;###autoload
  475. (defun tc-dissociate ()
  476.   "Turn off two-column minor mode in current and associated buffer.
  477. If the associated buffer is unmodified and empty, it is killed."
  478.   (interactive)
  479.   (let ((buffer (current-buffer)))
  480.     (save-excursion
  481.       (and (tc-other)
  482.        (set-buffer (tc-other))
  483.        (or (not (tc-other))
  484.            (eq buffer (tc-other)))
  485.        (if (and (not (buffer-modified-p))
  486.             (eobp) (bobp))
  487.            (kill-buffer nil)
  488.          (kill-local-variable 'tc-other)
  489.          (kill-local-variable 'tc-window-width)
  490.          (kill-local-variable 'tc-separator)
  491.          (kill-local-variable 'mode-line-format)
  492.          (kill-local-variable 'fill-column))))
  493.     (kill-local-variable 'tc-other)
  494.     (kill-local-variable 'tc-window-width)
  495.     (kill-local-variable 'tc-separator)
  496.     (kill-local-variable 'mode-line-format)
  497.     (kill-local-variable 'fill-column)))
  498.  
  499.  
  500. ;; this doesn't use yank-rectangle, so that the first column can
  501. ;; contain long lines
  502. ;;;###autoload
  503. (defun tc-merge ()
  504.   "Merges the associated buffer with the current buffer.
  505. They get merged at the column, which is the value of
  506. `tc-window-width', i.e. usually at the vertical window
  507. separator.  This separator gets replaced with white space.  Beyond
  508. that the value of gets inserted on merged lines.  The two columns are
  509. thus pasted side by side, in a single text.  If the other buffer is
  510. not displayed to the left of this one, then this one becomes the left
  511. column.
  512.  
  513. If you want `tc-separator' on empty lines in the second column,
  514. you should put just one space in them.  In the final result, you can strip
  515. off trailing spaces with \\[beginning-of-buffer] \\[replace-regexp] [ SPC TAB ] + $ RET RET"
  516.  
  517.   (interactive)
  518.   (or (tc-other)
  519.       (error "You must first set two-column minor mode."))
  520.   (and (> (car (window-edges)) 0)    ; not touching left edge of screen
  521.        (eq (window-buffer (previous-window))
  522.        (tc-other))
  523.        (other-window -1))
  524.   (save-excursion
  525.     (let ((b1 (current-buffer))
  526.       (b2 (tc-other))
  527.       string)
  528.       (goto-char (point-min))
  529.       (set-buffer b2)
  530.       (goto-char (point-min))
  531.       (while (not (eobp))
  532.     (setq string (buffer-substring (point)
  533.                        (progn (end-of-line) (point))))
  534.     (or (eobp)
  535.         (forward-char))        ; next line
  536.     (set-buffer b1)
  537.     (if (string= string "")
  538.         ()
  539.       (end-of-line)
  540.       (indent-to-column tc-window-width)
  541.       (insert tc-separator string))
  542.     (next-line 1)            ; add one if necessary
  543.     (set-buffer b2))))
  544.   (if (< (window-width) (frame-width))
  545.       (enlarge-window 99999 t)))
  546.  
  547. ;;;;; utility functions ;;;;;
  548.  
  549. ;;;###autoload
  550. (defun tc-associated-buffer ()
  551.   "Switch to associated buffer."
  552.   (interactive)
  553.   (or (tc-other)
  554.       (error "You must set two-column minor mode."))
  555.   (if (get-buffer-window (tc-other))
  556.       (select-window (get-buffer-window (tc-other)))
  557.     (switch-to-buffer (tc-other))))
  558.  
  559. ;; It would be desirable to intercept anything that causes the current
  560. ;; window to scroll.  Maybe a `scroll-hook'?
  561. ;;;###autoload
  562. (defun tc-scroll-line (arg)
  563.   "Scroll current window upward by ARG lines.
  564. The associated window gets scrolled to the same line."
  565.   (interactive "p")
  566.   (or (tc-other)
  567.       (error "You must set two-column minor mode."))
  568.   ; scroll-up has a bug on arg 0 at end of buffer
  569.   (or (zerop arg)
  570.       (scroll-up arg))
  571.   (setq arg (count-lines (point-min) (window-start)))
  572.   ; too bad that pre 18.57 Emacs makes save-window-excursion restore
  573.   ; the point.  When it becomes extinct, we can simplify this.
  574.   (if (get-buffer-window (tc-other))
  575.       (let ((window (selected-window)))
  576.     (select-window (get-buffer-window (tc-other)))
  577.     (setq arg (- arg (count-lines (point-min) (window-start))))
  578.     ; make sure that other buffer has enough lines
  579.     (save-excursion
  580.       (goto-char (point-max))
  581.       (insert-char ?\n
  582.                (- arg (count-lines (window-start) (point-max)) -1)))
  583.     (or (zerop arg)
  584.         (scroll-up arg))
  585.     (select-window window))))
  586.  
  587. ;;;###autoload
  588. (defun tc-scroll-up (arg)
  589.   "Scroll current window upward by ARG screens.
  590. The associated window gets scrolled to the same line."
  591.   (interactive "p")
  592.   (tc-scroll-line (* arg (- (window-height)
  593.                     next-screen-context-lines 1))))
  594.  
  595. ;;;###autoload
  596. (defun tc-scroll-down (arg)
  597.   "Scroll current window downward by ARG screens.
  598. The associated window gets scrolled to the same line."
  599.   (interactive "p")
  600.   (tc-scroll-line (* arg (- next-screen-context-lines
  601.                     (window-height) -1))))
  602.  
  603. ;;;###autoload
  604. (defun tc-recenter (arg)
  605.   "Center point in window.  With ARG, put point on line ARG.
  606. This counts from bottom if ARG is negative.  The associated window
  607. gets scrolled to the same line."
  608.   (interactive "P")
  609.   (setq arg (and arg (prefix-numeric-value arg)))
  610.   (tc-scroll-line (- (count-lines (window-start) (point))
  611.                  (cond ((null arg)  (/ (window-height) 2))
  612.                    ((< arg 0)  (+ (window-height) arg))
  613.                    (  arg)))))
  614.  
  615. (defun enlarge-window-horizontally (arg)
  616.   "Make current window ARG columns wider."
  617.   (interactive "p")
  618.   (enlarge-window arg t)
  619.   (and (tc-other)
  620.        (setq tc-window-width (+ tc-window-width arg))
  621.        (set-buffer (tc-other))
  622.        (setq tc-window-width (- tc-window-width arg))))
  623.  
  624. (defun shrink-window-horizontally (arg)
  625.   "Make current window ARG columns narrower."
  626.   (interactive "p")
  627.   (enlarge-window-horizontally (- arg)))
  628.  
  629. (provide 'two-column)
  630.  
  631. ;;; two-column.el ends here
  632.